perm filename TAB.F4[TAB,LCS] blob sn#213118 filedate 1976-04-27 generic text, type T, neo UTF8
00100	C CONVERTS LUTE TABLATURE TO STANDARD INPUT FOR MS.
00200	
00300		DIMENSION I(72),IQ(72),LET(14),NUM(8),LIST(14),KLST(8)
00400		1,RI(72),STR(50),FOR(4)
00500	C NO MORE THAN 50 NOTES PER FILE.
00600	C NOTE: USE 'C' FOR r AND 'Q' FOR k. (R=REST, K=KEY SIG.)
00700	C ON THE OTHER HAND!  USE 'Z' FOR MEASURE LINES ('M' IS TABLATURE ITEM)
00800		DATA LET/'A','B','C','D','E','F','G','H','I','J','Q',
00900		1 'L','M','N'/,NUM/'1','2','3','4','5','6','7','8'/
01000		1,LSL/'/'/,IBLA/' '/,ICOL/':'/,ISEMI/';'/,MIN/'-'/
01100		1,IR/'R'/,IX/'X'/,IZ/'Z'/,M100/100/
01200		1,LIST/'A','B','B','C','C','D','E','E','F','F',
01300		1 'G','G','A','B'/,IS/'S'/,IK/'K'/
01400		1,KLST/'B','E','A','D', 'F','C','G','D'/
01500		1,FOR/'(I4,F',0,'4.2,A','1)   '/,F3/'3.0,F'/,F4/'4.0,F'/
01600		EQUIVALENCE (ID,LET(4)),(IF,LET(6)),(IM,LET(13)),(IN,LET(14))
01700		1,(RI,I)
01800	
01900		TYPE 1
02000	1	FORMAT(' TYPE FILE NAME -- '$)
02100	2	FORMAT(A5)
02200		ACCEPT 2,NAME
02300		TYPE 3
02400		ACCEPT 2,NM2
02500	3	FORMAT(' TYPE OUTPUT NAME -- '$)
02600	20	FORMAT(I,72A1)
02700	22	FORMAT(' 100 ',72A1)
02800		IF(NM2.EQ.IBLA)NM2='TABL'
02900		CALL IFILE(1,NAME)
03000		CALL OFILE(21,NM2)
03100		ISGN=0
03200		JND=0
03300	
03400	240	MODE=-1
03500		READ(1,20,END=102)L,I
03600		TYPE 20,L,I
03700	C READS SOS LINE NUMBERS
03800	
03900		IMIN=0
04000		ITOT=0
04100		ICHRD=0
04200		NN=1
04300	
04400		NTS=-1
04500	21	N=1
04600	8	J=0 
04700		NX=0
04800		NL=-1
04900	31	JM=M
05000		M=I(N)
05100		IF(M.EQ.LSL)GO TO 10
05200		IF(M.EQ.ICOL)GO TO 10
05300		IF(M.EQ.ISEMI)GO TO 13
05400		IF(M.NE.IBLA)GO TO 36
05500		IF(JM.EQ.M)GO TO 35
05600	C NEVER MORE THAN ONE BLANK AT A TIME.
05700		GO TO 7
05800		
05900	36	DO 32 K=1,14
06000	32	IF(M.EQ.LET(K))GO TO 11
06100		IF(M.NE.IS.AND.M.NE.IR)GO TO 76
06200	C  FINDS 'S' OR 'R'
06300		LETX=0
06400		NX=NX+1
06500		IQ(NX)=M
06600		N=N+1
06700		M=I(N)
06800		GO TO 7
06900	C  FOR 'SD' AND 'SU', 'RD', 'RI'
07000	
07100	76	IF(M.EQ.'0')GO TO 74
07200	C  BASS STRINGS ARE 0, -1, -2, ETC.  -- ALSO USE /SD/
07300		IF(M.NE.MIN)GO TO 33
07400	
07500	9	IMIN=-1
07600		LETX=-1
07610		J=0
07655	C  SO OCT. NUM WILL APPEAR FOR HIGH NOTES AFTER BASS STRINGS
07700		N=N+1
07800		M=I(N)
07900	33	DO 34 K=1,8
08000	34	IF(M.EQ.NUM(K))GO TO 12
08100		LETX=0
08200		IF(M.NE.IK)GO TO 37
08300		ISGN=1
08400	C FOUND A KSIG
08500	39	NX=NX+1
08600		IQ(NX)=M
08700		N=N+1
08800		M=I(N)
08900		IF(M.NE.MIN)GO TO 33
09000	C FOUND MINUS
09100		ISGN=-1
09200		GO TO 39
09300	
09400	74	L=7 
09410		J=0
09500		LETX=-1
09600	77	NX=NX+1
09700	C  FOR OCTAVE NUM
09800		IQ(NX)=LET(L)
09900		NX=NX+1
10000		M=3
10100		IF(L.LT.3)M=2
10200		IQ(NX)=NUM(M)
10300		GO TO 35
10400	75	L=7-K
10500		IMIN=0
10600		GO TO 77
10700	
10800	37	IF(M.EQ.IZ)M=IM
10900	C  CHANGE Z (MEASURE) TO M
11000		GO TO 7
11100	
11200	35	N=N+1
11300		IF(N.LT.72)GO TO 31
11400		IF(NX.GT.72)GO TO 101
11500		WRITE(21,22)(IQ(K),K=1,NX)
11600		TYPE 22,(IQ(K),K=1,NX)
11700	14	IF(MODE)GO TO 140
11800		MODE=MODE+1
11900		IF(MODE.EQ.3)GO TO 240
12000	C  FOR RESTART. DON'T PUT BASS STRS FIRST. ONLY 1 LN FOR BMS &SLRS
12100	140	READ(1,20,END=100)L,I
12200		TYPE 20,L,I
12300		IF(NTS)GO TO 21
12400	C  NEXT FOR LINES AFTER NOTES.
12500	C NEXT FOR STRING NUMS.
12600		IF(I(1).NE.IBLA)GO TO 70
12700	C TO SKIP ALL RHYTH LINES
12800		IF(MODE.GE.0)GO TO 70
12900	C SO WE WON'T EVER COME BACK HERE
13000	73	L=0 
13100		NL=LSL
13200	CC	ITOT=ITOT-1
13300		FOR(2)=F3
13400		NA=0
13500		DO 71 K=1,ITOT
13600	C  ITOT = TOTAL NUM OF NOTES
13700		A=STR(K)
13800		IF(A)GO TO 71
13810		JJ=K
13820	171	JJ=JJ+1
13830		IF(STR(JJ).GT.0)GO TO 272
13835		IF(JJ.EQ.ITOT)NL=ISEMI
13840		GO TO 171
13900	272	NA=NA+1
14000		L=L+2
14100		RI(L-1)=NA
14200		RI(L)=A*.01
14300		IF(K.EQ.ITOT)NL=ISEMI
14400		IF(NA.GT.9)FOR(2)=F4
14500	CC71	WRITE(21,72)RI(L-1),RI(L),M
14600		TYPE FOR,M100,RI(L-1),RI(L),NL
14700		WRITE(21,FOR)M100,RI(L-1),RI(L),NL
14850	71	CONTINUE
15000		MODE=0
15100	C  NOW SET MODE COUNTER TO PREPARE FOR RESTART
15200		GO TO 14
15300	70	WRITE(21,22)(I(K),K=1,72)
15400		GO TO 14
15500	100	IF(NL.NE.ISEMI)GO TO 73
15600	102	STOP
15700	101	FORMAT(' TOO MUCH ON LINE')
15800		TYPE 101
15900		STOP
16000	
16100	11	NL=K
16200	C  THE NUMB. OF THE LETTER
16300		LETX=-1
16400		GO TO 35
16500	12	IF(ISGN.EQ.0)GO TO 47
16600	C NEXT FOR KSIG SETUP
16700		JFST=5
16800		IF(ISGN)JFST=1
16900		JND=JFST+K-1
17000		ISGN=0
17100	47	IF(IMIN)GO TO 75
17200	C JUMP FOR BASS STRINGS
17300		IF(NL)GO TO 7
17400		NN=K
17500	C  THE NUMBER
17600		GO TO 35
17700	
17800	C NEXT AFTER IT FOUND SLASH OR SEMICOLON
17900	13	NTS=0
18000	10	IF(LETX.EQ.0)GO TO 110
18100		ITOT=ITOT+1
18200	C  SAVE THE STRING NUM.
18300		NA=NN
18400		IF(ICHRD.EQ.ICOL)NA=-1
18500	C FLAG FOR CHORD NOTES (CAN'T SPECIFY STRING IN BEAMS SUBR.)
18600		STR(ITOT)=NA
18700		ICHRD=M
18800	110	IF(NL)GO TO 7
18900		JOCT=0
19000		GO TO(41,42,43,44,45,46),NN
19100	46	NA=0
19200		GO TO 5
19300	45	NA=5
19400	C THESE ARE ADDERS FOR 'LIST'
19500		GO TO 5
19600	44	NA=8
19700		GO TO 5
19800	43	NA=0
19900		GO TO 6
20000	C NOW ON THE UPPER 3 STRINGS
20100	42	NA=5
20200		GO TO 6
20300	41	NA=8
20400	6	JOCT=1
20500	C  THE OCTAVE ADDER
20600	5	NX=NX+1
20700		NB=NL+NA
20800	C PUT A NOTE AWAY
20900	18	L=LIST(NB)
21000		IQ(NX)=L
21100	C THE FOUND-NOTE FLAG
21200	C  SAVE THE STRING NUM.
21300	58	GO TO(51, 52,51,51, 55,51, 52,51,51, 55,51, 55,51, 52),NB
21400	C  FINDS FLAT OR SHARP --  WHAT ABOUT KSIG.
21500	52	K=IF
21600		GO TO 50
21700	55	K=IS
21800	50	IF(JND.EQ.0)GO TO 53
21900		DO 54 KA=JFST,JND
22000	54	IF(L.EQ.KLST(KA))GO TO 56
22100	C  LOOK FOR KSIG MATCH UP
22200		GO TO 53
22300	56	IF(K.NE.0)GO TO 57
22400		K=IN
22500	C MAKES A NATURAL
22600	53	NX=NX+1
22700		IQ(NX)=K
22800	57	NA=3
22900		NL=-1
23000		IF(NB.GT.3)NA=4
23100		NA=NA+JOCT
23200		IF(J.EQ.NA)GO TO 7
23300	C  AVOIDS REPEATING OCT. NUM
23400		J=NA
23500		NX=NX+1
23600		IQ(NX)=NUM(NA)
23700	7	NX=NX+1
23800		IQ(NX)=M
23900		IF(M.EQ.ISEMI)NTS=0
24000		GO TO 35
24100	51	K=0
24200		GO TO 50